home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_geomview.idb / usr / freeware / lib / geomview / modules / tcl / Slicer.z / Slicer
Encoding:
Text File  |  1999-01-26  |  9.1 KB  |  299 lines
  1. emodule_init ndutils
  2.  
  3. proc EquationMaker {} {
  4.     global dim D
  5.     for {set i 1} {$i <= $dim} {incr i} {
  6.         global x$i
  7.     }
  8.     set eqn ""
  9.     for {set i 1} {$i <= $dim} {incr i} {
  10.         append eqn "a$i"
  11.         append eqn "x$i"
  12.         if {$i < $dim} {
  13.             append eqn " + "
  14.         }
  15.     }
  16.     append eqn " = D"
  17.     label .top.header -text "Hyperplane given by:"
  18.     label .top.eqn -text $eqn
  19.     frame .top.entries
  20.     for {set i 1} {$i <= $dim} {incr i} {
  21.         frame .top.entries.line$i
  22.         label .top.entries.line$i.l -text "a$i ="
  23.         entry .top.entries.line$i.e -width 10 -relief sunken -textvariable x$i
  24.         pack .top.entries.line$i.l .top.entries.line$i.e -side left -padx 1m -pady 1m
  25.     }
  26.     frame .top.entries.final
  27.     label .top.entries.final.l -text "D ="
  28.     entry .top.entries.final.e -width 10 -relief sunken -textvariable D
  29.     pack .top.entries.final.l .top.entries.final.e -side left -padx 1m -pady 1m
  30.     pack .top.header .top.eqn -side top -padx 1m
  31.     for {set i 1} {$i <= $dim} {incr i} {
  32.         pack .top.entries.line$i -side top 
  33.     }
  34.     pack .top.entries.final -side top
  35.     pack .top.entries -side top
  36.     for {set i 1} {$i <= $dim} {incr i} {
  37.         bind .top.entries.line$i.e <Return> "ReturnPict"
  38.     }
  39.     bind .top.entries.final.e <Return> "ReturnPict"
  40. }
  41.  
  42. proc ReturnPict {} {
  43.     global dim D camera
  44.     for {set i 1} {$i <= $dim} {incr i} {
  45.         global x$i
  46.     }
  47.     set eqn {}
  48.     set eqn [lappend eqn $D]
  49.     for {set i 1} {$i <= $dim} {incr i} {
  50.         set stuff x$i
  51.         set temp [set $stuff]
  52.         set eqn [lappend eqn $temp]
  53.     }
  54.     set eqn [join $eqn { }]
  55.     UpdatePicture $dim $eqn $camera
  56.         UpdatePicture $dim $eqn $camera
  57.         UpdatePicture $dim $eqn $camera
  58. }
  59.  
  60. proc RefreshScreen {} {
  61.     global dim D camera contupdate
  62.         for {set i 1} {$i <= $dim} {incr i} {
  63.                 global x$i
  64.         }
  65.     destroy .top.header
  66.     destroy .top.eqn
  67.     destroy .top.entries
  68.     EquationMaker
  69. }
  70.  
  71. proc Update {} {
  72.     global dim D camera contupdate
  73.     for {set i 1} {$i <= $dim} {incr i} {
  74.         global x$i
  75.     }
  76.     set flag [ObjExistCheck $camera]
  77.         if {$flag != "yes"} {
  78.                 tk_dialog .error Error "Camera $camera does not exist" {} 0 OK
  79.                 set contupdate 0
  80.         } else {
  81.         set newdim [GetDim]
  82.         if {$newdim != $dim} {
  83.                 if {$newdim < $dim} {
  84.                 set dim $newdim
  85.                 CreateClipPlane $dim $camera
  86.                 RefreshScreen 
  87.             } else {
  88.                 for {set i [expr $dim + 1]} {$i<=$newdim} {incr i} {
  89.                     global x$i
  90.                     set x$i 0
  91.                 }
  92.                 set dim $newdim
  93.                 CreateClipPlane $dim $camera
  94.                 RefreshScreen
  95.             }
  96.         }
  97.         set list [GetData $dim $camera]
  98.         if {$list == "NoObj"} {
  99.             CreateClipPlane $dim $camera
  100.             Update
  101.         } else {
  102.             set list [split $list { }]
  103.             set D [lindex $list 0]
  104.             for {set i 1} {$i <= $dim} {incr i} {
  105.                     set x$i [lindex $list $i]
  106.             }
  107.         }
  108.     }
  109. }
  110.  
  111. proc ContUpdate {} {
  112.         global dim D contupdate
  113.         for {set i 1} {$i <= $dim} {incr i} {
  114.                 global x$i
  115.         }
  116.     focus .cont
  117.     while {$contupdate} {
  118.         update
  119.         Update
  120.     }
  121.     grab release .cont
  122. }
  123.  
  124. proc Quit {} {
  125.     global contupdate
  126.     set contupdate 0
  127.     update
  128.     exit
  129. }
  130.  
  131. proc CutIt {} {
  132.     global dim D object method d n HideEdge HideFace
  133.     for {set i 1} {$i <= $dim} {incr i} {
  134.         global x$i
  135.     }
  136.         set eqn {}
  137.         set eqn [lappend eqn $D]
  138.         for {set i 1} {$i <= $dim} {incr i} {
  139.                 set stuff x$i
  140.                 set temp [set $stuff]
  141.                 set eqn [lappend eqn $temp]
  142.         }
  143.         set eqn [join $eqn { }]
  144.     if {$method == 3} {
  145.         set successful [SliceNDice $object $dim $eqn $method $n $d $HideEdge $HideFace]
  146.     } elseif {$method == 4} {
  147.         set successful [SliceNDice $object $dim $eqn $method $n $HideEdge $HideFace]
  148.     } else {
  149.         set successful [SliceNDice $object $dim $eqn $method]
  150.     }
  151.     if {$successful != "yes"} {
  152.         if {$successful == "NoObj"} {
  153.             tk_dialog .error Error "Object $object does not exist"\
  154.                 {} 0 OK
  155.         } elseif {$successful == "DiffDims"} {
  156.             tk_dialog .error Error "Object and hyperplane do not\
  157.                 agree in dimension" {} 0 OK
  158.         } else {
  159.             tk_dialog .error Error "Irrecoverable data error"\
  160.                 {} 0 OK
  161.         }
  162.     }
  163. }
  164.  
  165. proc DiceData {newmethod} {
  166.     global d n method HideEdge HideFace methodvar
  167.     set method $newmethod
  168.     destroy .dice.inner
  169.     frame .dice.inner
  170.     if {$method == 0} {
  171.         frame .dice.inner.empty
  172.         pack .dice.inner.empty
  173.         set methodvar "Clip: keep both sides"
  174.     } elseif {$method == 1} {
  175.         frame .dice.inner.empty
  176.         pack .dice.inner.empty
  177.         set methodvar "Clip: keep < side only"
  178.     } elseif {$method == 2} {
  179.         frame .dice.inner.empty
  180.         pack .dice.inner.empty
  181.         set methodvar "Clip: keep > side only"
  182.     } elseif {$method == 3} {
  183.         frame .dice.inner.data -borderwidth 4 -relief groove
  184.         label .dice.inner.data.note -text "For dicing only"
  185.         pack .dice.inner.data.note -side top
  186.         frame .dice.inner.data.d
  187.         label .dice.inner.data.d.l -text "d = "
  188.         entry .dice.inner.data.d.e -relief sunken -width 10 -textvariable d
  189.         pack .dice.inner.data.d.l .dice.inner.data.d.e -side left
  190.         pack .dice.inner.data.d -padx 1m -pady 1m -side top
  191.         frame .dice.inner.data.n
  192.         label .dice.inner.data.n.l -text "n = "
  193.         entry .dice.inner.data.n.e -relief sunken -width 10 -textvariable n
  194.         pack .dice.inner.data.n.l .dice.inner.data.n.e -side left
  195.         pack .dice.inner.data.n -side top -padx 1m -pady 1m
  196.         label .dice.inner.data.special -text "In alternating slices:"
  197.         checkbutton .dice.inner.data.hideedge -text "Hide Edges" -variable HideEdge
  198.         checkbutton .dice.inner.data.hideface -text "Hide Faces" -variable HideFace
  199.         pack .dice.inner.data.special .dice.inner.data.hideedge .dice.inner.data.hideface -side top -fill x -padx 1m -pady 1m
  200.         pack .dice.inner.data
  201.         bind .dice.inner.data.d.e <Return> ".cut.doit flash; CutIt"
  202.         bind .dice.inner.data.n.e <Return> ".cut.doit flash; CutIt"
  203.         set methodvar "Dice: create n slabs between D and d"
  204.     } else {
  205.         frame .dice.inner.data -borderwidth 4 -relief groove
  206.         label .dice.inner.data.note -text "For dicing only"
  207.         pack .dice.inner.data.note -side top
  208.         frame .dice.inner.data.n
  209.         label .dice.inner.data.n.l -text "n = "
  210.         entry .dice.inner.data.n.e -relief sunken -width 10 -textvariable n
  211.         pack .dice.inner.data.n.l .dice.inner.data.n.e -side left
  212.         pack .dice.inner.data.n -side top -padx 1m -pady 1m
  213.         label .dice.inner.data.special -text "In alternating slices:"
  214.         checkbutton .dice.inner.data.hideedge -text "Hide Edges" -variable HideEdge
  215.         checkbutton .dice.inner.data.hideface -text "Hide Faces" -variable HideFace
  216.         pack .dice.inner.data.special .dice.inner.data.hideedge .dice.inner.data.hideface -side top -fill x -padx 1m -pady 1m
  217.         pack .dice.inner.data
  218.         bind .dice.inner.data.n.e <Return> ".cut.doit flash; CutIt"
  219.         set methodvar "Dice: cut object into n pieces"
  220.     }
  221.     pack .dice.inner
  222. }
  223.  
  224. set camera [GetFocusCam]
  225. frame .top -borderwidth 4 -relief ridge
  226. pack .top -side top -fill x -padx 1m -pady 1m
  227. set dim [GetDim]
  228. CreateClipPlane $dim $camera
  229. Update
  230. EquationMaker
  231.  
  232. set contupdate 1
  233. set object g1
  234. set method 0
  235. set methodvar "Clip: keep both sides"
  236. set HideEdge 0
  237. set HideFace 0
  238. frame .cont -relief ridge -borderwidth 4
  239. label .cont.title -text "Method for computing hyperplane:"
  240. frame .cont.buttons
  241. radiobutton .cont.buttons.yes -text "Automatic Update" -variable contupdate\
  242.      -value 1 -command ContUpdate
  243. radiobutton .cont.buttons.no -text "Manual Entry" -variable contupdate -value 0
  244. pack .cont -side top -fill x -padx 1m -pady 1m
  245. pack .cont.title .cont.buttons -padx 1m -pady 1m -side top
  246. pack .cont.buttons.yes .cont.buttons.no -padx 1m -pady 1m -side left
  247. frame .cont.options
  248. button .cont.options.singleupdate -text "Single Update" -command Update
  249. frame .cont.options.cam
  250. label .cont.options.cam.l -text Camera
  251. entry .cont.options.cam.e -relief sunken -width 15 -textvariable camera
  252. pack .cont.options.cam.l .cont.options.cam.e -side left
  253. pack .cont.options.singleupdate .cont.options.cam -padx 1m -pady 1m\
  254.     -side left
  255. pack .cont.options -side top 
  256. bind .cont.options.cam.e <Return> "Update"
  257. frame .target -borderwidth 4 -relief ridge
  258. frame .target.inner
  259. label .target.inner.l -text "Object to be sliced:"
  260. entry .target.inner.e -relief sunken -width 15 -textvariable object
  261. pack .target.inner.l .target.inner.e -side left -pady 1m
  262. pack .target.inner -side top
  263. pack .target -side top -padx 1m -pady 1m -fill x
  264. frame .cutops -borderwidth 4 -relief ridge
  265. label .cutops.l -text "Slicing Options:"
  266.  
  267. menubutton .cutops.pup -textvariable methodvar -relief raised \
  268.         -menu .cutops.pup.m
  269. menu .cutops.pup.m
  270. .cutops.pup.m add command -label "Clip: keep both sides"\
  271.     -command "DiceData 0"
  272. .cutops.pup.m add command -label "Clip: keep <D side only"\
  273.     -command "DiceData 1"
  274. .cutops.pup.m add command -label "Clip: keep >D side only"\
  275.     -command "DiceData 2"
  276. .cutops.pup.m add command -label "Dice: create n slabs between D and d"\
  277.     -command "DiceData 3"
  278. .cutops.pup.m add command -label "Dice: cut object into n pieces"\
  279.     -command "DiceData 4"
  280. pack .cutops.l .cutops.pup -side left -fill x -padx 1m -pady 1m
  281. pack .cutops -side top -fill x -padx 1m -pady 1m
  282. frame .dice
  283. frame .dice.inner
  284. frame .dice.inner.empty
  285. pack .dice.inner.empty
  286. pack .dice.inner.empty
  287. pack .dice -side top -pady 1m
  288. frame .cut
  289. button .cut.doit -text Slice! -font -Adobe-Times-Bold-R-Normal-*-180-*\
  290.     -command CutIt
  291. pack .cut.doit -padx 1m -pady 1m -ipadx 1m -ipady 1m
  292. pack .cut -side top -fill x
  293. bind .target.inner.e <Return> ".cut.doit flash; CutIt"
  294. frame .exit
  295. button .exit.b -text "Exit" -command Quit
  296. pack .exit.b -side right -padx 1m -pady 1m
  297. pack .exit -side bottom -fill x
  298. ContUpdate
  299.